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-- file stack. mesa 

-- last modified by Sweet, July 5. 1978 9:08 AM 

DIRECTORY 

AltoDefs: FROM "aUodefs" USING [Address, BYTE, VMLimit. wordlength]. 

Code: FROM "code" USING [acstack, ACStackOverf low, ACStackUnderf low, codeptr, curctxlvl, framesz, mai 
**nBody, stking, tempcontext, tempstart], 

CodeDefs: FROM "codedefs" USING [CCIndex, CCNull, ChunkBase, EvalStackSize, Lexeme, Stklndex, Stkltem 
**, TempStateRecord, topostack], 

ComData: FROM "comdata" USING [bodylndex, mainCtx, objectFrameSize] , 

ErrorDefs: FROM "errordefs" USING [errorsei], 

FOpCodes: FROM "fopcodes" USING [qEXCH, qFREE], 

P5ADefs: FROM "p5adefs" USING [CioutO, createlabel, deletecell, makeBDOItem, MinimalStack, PopEffect. 
** PushEffect, sCassign, slCassign], 

P5BDefs: FROM "p5bdefs" USING [pushlex], 

StringDefs: FROM "stringdeFs" USING [WordsForString] , 

SymDefs: FROM "symdefs" USING [BitAddress, bodytype, ContextLevel , CSEIndex, CTXIndex. ctxtype, HTInd 
♦*ex. HTNull. ISEIndex. ISENull, IG, IZ, SEIndex, SENull, SERecord, setype. typeANY], 

SymTabDefs: FROM "symtabdefs" USING [makenewctx, NextSe, setselink], 

SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode] . 

TableDefs: FROM "tabledefs" USING [Allocate, TableBase, TableNotif ier], 

TreeDefs: FROM "treedefs" USING [treetype]; 

DEFINITIONS FROM CodeDefs; 

Stack: PROGRAM 

IMPORTS MPtr: ComData, CPtr: Code, ErrorDefs, P5ADefs, P5BDefs, StringDefs, SymTabDefs, SystemDefs, 
** TableDefs 

EXPORTS CodeDefs. P5ADefs « 
BEGIN 
OPEN P5ADefs, P5BDefs; 

-- imported definitions 

Address: TYPE = Al toDefs .Address; 

BYTE: TYPE « Al toDef s .BYTE; 

VMLimit: CARDINAL » Al toDefs .VMLimit ; 

wordlength: CARDINAL « AltoDefs. wordlength; 

BitAddress: TYPE = SymDefs. BitAddress; 
ContextLevel: TYPE = SymDefs .ContextLevel ; 
CSEIndex: TYPE = SymDefs .CSEIndex; 
CTXIndex: TYPE « SymDefs .CTXIndex; 
HTIndex: TYPE = SymDefs .HTIndex; 
HTNull: HTIndex = SymDefs .HTNull ; 
ISEIndex: TYPE = SymDefs. ISEIndex; 
ISENull: ISEIndex = SymDefs . ISENull ; 
IZ: ContextLevel » SymDefs. IZ; 
IG: ContextLevel = SymDefs. IG; 
SEIndex: TYPE = SymDefs .SEIndex; 
SENull: SEIndex = SymDefs .SENull ; 
SERecord: TYPE = SymDefs .SERecord; 
typeANY: CSEIndex « SymDefs . typeANY; 

InvalidHeapRelease: SIGNAL = CODE; 
InvalidTempRelease: SIGNAL = CODE; 

seb: TableDefs. TableBase; -- semantic entry base (local copy) 

ctxb: TableDefs .TableBase; -- context entry base (local copy) 

cb: ChunkBase; -- code base (local copy) 
bb: TableDefs .TableBase; -- body table base (local copy) 

StackNotify: PUBLIC TableDefs .TableNotif ier - 

BEGIN -- called by allocator whenever table area is repacked 

seb *- base[SymDefs .setype]; 

ctxb ♦- base[SymDefs. ctxtype]; 

cb ^ LOOPHOLE[base[TreeDefs. treetype]]; 

bb *■ base[SymDefs .bodytype] ; 

RETURN 

END; 

pendtempl ist , tempi istpool , templist, heaplist: ISEIndex; 
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stklist: Stklndex; 

stkptr: Stklndex; 

stkUB: INTEGER ^ EvalStackSize - 2; 

StackModelingError: SIGNAL ■ CODE; 

StkNull: Stklndex - NIL; 

ItemStklndex: TYPE - POINTER TO item Stkltem; 

Stacklnit: PUBLIC PROCEDURE - 

BEGIN -- called at beginning of MODULE to init stack stuff 

pendtemplist ^ templistpool ♦- templist ^ heaplist ^ ISENull; 

stkptr ^ stklist <- StkNull; 

CPtr.tempcontext ^ SymTabDefs.makenewctx[lZ]; 

StkUB ♦" EvalStackSize - 1; 

CPtr.stking ♦- FALSE; 

RETURN 

END; 

StackFinal: PUBLIC PROCEDURE - 

BEGIN -- called at end of MODULE to release stack items 
s: Stklndex; 

UNTIL stklist - StkNull DO 

s ^ stklist; 

stklist ♦- stkl ist. upl ink; 

SystemDef s.FreeHeapNode[s]; 

ENDLOOP; 
RETURN 
END; 

stkerror: PROCEDURE » BEGIN SIGNAL StackModelingError; RETURN END; 

pushtempstate: PUBLIC PROCEDURE [p: POINTER TO TempStateRecord , newfs: CARDINAL] 
BEGIN 
pt 4- TempStateRecord[pendtempl ist: pendtemplist, templist: templist, 

heaplist: heaplist, tempctxlvl: (ctxb+CPtr . tempcontext) .ctxlevel . 

tempstart: CPtr. tempstart , framesz: CPtr.f ramesz]; 
pendtemplist <- templist ^ heaplist <- ISENull; 
(ctxb+CPtr. tempcontext) .ctxlevel ♦- CPtr.curctxlvl ; 
CPtr. tempstart ♦- CPtr. framesz ^ newfs; 
RETURN 
END; 



poptempstate: PUBLIC PROCEDURE [p: POINTER TO TempStateRecord] » 

BEGIN 

purgepend tempi ist[]; 

[pendtemplist: pendtemplist, templist: templist, 

heaplist: heaplist, tempctxlvl: (ctxb+CPtr . tempcontext) .ctxlevel , 
tempstart: CPtr .tempstart, framesz: CPtr.f ramesz] ^ pt; 

RETURN 

END; 



stackoff: PUBLIC PROCEDURE - 

BEGIN -- turns stack modelling off 

CPtr.stking ♦- FALSE; 

RETURN 

END; 



stackon: PUBLIC PROCEDURE - 

BEGIN -- turns stack modelling on 

CPtr.stking ♦- TRUE; 

RETURN 

END; 



push: PROCEDURE [1: se Lexeme] « 
BEGIN — adds item to stack 
s: Stklndex ^ stackanoc[]; 
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St i- StkItem[down1 ink: stkptr, uplink: , stkvalue: item[1]]; 
IF stkptr ff StkNull THEN 

BEGIN 

s. uplink ^ stkptr. upl ink; 

stkptr. upl ink ♦- s; 

END 
ELSE s. uplink ^ StkNull; 
stkptr <r s; 
RETURN 
END; 



pop: PUBLIC PROCEDURE - 

BEGIN -- moves stkptr down the stack 
s: Stklndex ♦- stkptr; 

IF stkptr - StkNull THEN BEGIN stkerror[]; RETURN END; 

stkptr ♦- stkptr. downlink; 

delstkitems[s,l]; 

RETURN 

END; 



delstkitems: PROCEDURE [s: Stklndex, n: CARDINAL] - 
BEGIN -- removes n items from s upward (including s) 
ns, ds: Stklndex; 

ds ^ s. downlink; 
THROUGH [1. .n] DO 

ns <- s.upl ink; 

stackfree[s]; 

s «- ns; 

ENDLOOP; 
IF ds ff StkNull THEN ds, uplink ♦- s; 
IF s j^ StkNull THEN s. downlink ♦- ds; 
RETURN 
END; 



stackalloc: PROCEDURE RETURNS [s: Stklndex] - 
BEGIN -- allocates a stkitem 
IF (s ♦- stklist) # StkNull THEN 

BEGIN 

stklist ^ s.upl ink; 

RETURN; 

END; 
s ♦- SystemDefs.AnocateHeapNode[SIZE[StkItem]]; 
RETURN 
END; 



stackfree: PROCEDURE [s: Stklndex] - 
BEGIN -- frees a stkitem 
WITH s SELECT FROM 
MARK -> 
BEGIN 

IF CPtr.codeptr « label THEN CPtr.codeptr ^ cb[label].bl ink; 
deletecel l[label]; 
END; 
ENDCASE; 
s. uplink <- stklist; stklist ^ s; 
RETURN 
END; 



clearstack: PUBLIC PROCEDURE - 

BEGIN -- clears out the entire stack 
s: Stklndex <- stkptr; 

UNTIL s - StkNull DO 

stkptr *- s. downlink; 

stackfree[s]; 

s <- stkptr; 

ENDLOOP; 
RETURN 
END; 
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newstack: PUBLIC PROCEDURE RETURNS [s: Stklndex] - 

BEGIN -- sets up a new (empty) stack returning old stkptr 

s <r stkptr; 

stkptr <- StkNun ; 

RETURN 

END; 

restoreoldstack: PUBLIC PROCEDURE [s: Stklndex] ■ 
BEGIN -- inverse of newstack 
clearstack[]; 
stkptr ^ s; 
RETURN 
END; 

markstack: PUBLIC PROCEDURE - 

BEGIN -- marks stack for fork reset 
s: Stklndex ^ stackanoc[]; 

St 4- Stkltem[up1ink: , downlink: stkptr, stkvalue: MARK[1abe1: createlabel[]]]; 
IF stkptr ^ StkNull THEN 

BEGIN 

s. uplink <- stkptr . up! ink; 

stkptr .up! ink <- s; 

END 
ELSE s. uplink <- StkNull; 
stkptr <- s; 
RETURN 
END; 

resettomark: PUBLIC PROCEDURE ■ 

BEGIN -- resets stkptr to nearest mark making sure all 

— intervening items are on the stack 
s: Stklndex ^ stkptr; 
n: CARDINAL ^ 0; 

DO 

IF s = StkNull THEN BEGIN stkerror[]; RETURN END; 
WITH s SELECT FROM 
MARK »> 

BEGIN chkrandsonstack[n]; stkptr <- s; RETURN END; 
ENDCASE; 
n <- n+1; 
s <- s. downlink; 
ENDLOOP 
END; 

unmarkstack: PUBLIC PROCEDURE « 

BEGIN -- ensures all items down to nearest mark are on stack 

-- and removes mark (called by last branch of expression forks) 

-- does NOT change stkptr 
s: Stklndex <- stkptr; 
n: CARDINAL ♦- 0; 

DO 

IF s = StkNull THEN BEGIN stkerror[]; RETURN END; 
WITH s SELECT FROM 
MARK «> 

BEGIN putrandsonstack[n]; del stkitems[s. 1] ; RETURN END; 
ENDCASE; 
n ^ n+1; 
s <- s. downlink; 
ENDLOOP 
END; 

deletetomark: PUBLIC PROCEDURE - 

BEGIN ~- like resettomark, but also deletes mark 
s: Stklndex; 

resettomark[]; 

IF (s *- stkptr) - StkNull THEN BEGIN stkerror[]; RETURN END; 
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stkptr <- stkptr. downlink; 
de1stkitems[s, 1]; 
RETURN; 
END; 

incrstack: PUBLIC PROCEDURE [n: CARDINAL] ■ 
BEGIN -- pushes n items onto the stack 
THROUGH [l.,n] DO push[topostack] ENDLOOP; 
RETURN 
END; 

dumpstack: PUBLIC PROCEDURE - 

BEGIN -- puts all stkitems into temps 

s: Stklndex <- stkptr; 

ss: Stklndex ^ stkptr; 

savcodeptr: CCIndex ♦- CPtr. codeptr; 

n: CARDINAL <- 0; 

stackoff[]; 
DO 

IF s ■ StkNun THEN 
BEGIN 

unloadstack[ss,n]; 

stackon[]; CPtr. codeptr ♦- savcodeptr; 
UNTIL cb[CPtr. codeptr]. flink « CCNull 

DO CPtr. codeptr <- cb[CPtr.codeptr].f 1 ink ENDLOOP; 
RETURN 
END; 
WITH s SELECT FROM 
MARK ■> 

BEGIN un1oadstack[ss,n]; n ♦- 0; ss ♦- downlink; CPtr. codeptr ^ label; END; 
item "> 

IF lexeme # topostack THEN 

BEGIN unloadstack[ss,n]; EXIT END 
ELSE n <- n+1; 
ENDCASE; 
s <- s. downlink; 
ENDLOOP; 
UNTIL (s ♦- s. downlink) » StkNull 
DO 

WITH s SELECT FROM 
item »> 

IF lexeme ■ topostack THEN stkerror[]; 
ENDCASE; 
ENDLOOP; 
stackon[]; 

CPtr. codeptr ^ savcodeptr; 
UNTIL cb[CPtr. codeptr]. flink » CCNull 

DO CPtr. codeptr *- cb[CPtr . codeptr] . fl ink ENDLOOP; 
RETURN 
END; 

bltnwordsfromstack: PUBLIC PROCEDURE [n: CARDINAL] RETURNS [tlex: se Lexeme] « 
BEGIN -- put n top words of stack in contiguous storage 
a: BitAddress; 

IF n " THEN BEGIN stkerror[]; RETURN END; 
stackoFf[]; 

unloadstackcontiguous[stkptr,n]; 
WITH stkptr SELECT FROM 
item «> 

BEGIN 

a «- (seb+lexeme. lexsei) . idvalue; 

tlex <- createtemplex[a.wd+l-n, n]; 

END; 
ENDCASE; 
stackon[]; 
RETURN 
END; 

unloadstack: PROCEDURE [s: Stklndex^ n: CARDINAL] - 
BEGIN -- main subr for dumpstack 
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tlex: se Lexeme; 
tempsneeded: CARDINAL <- 0; 
ts: CARDINAL; 
ss: Stklndex ♦• s; 
nn: CARDINAL ^ n; 

DO 

IF nn ■ THEN EXIT; 

IF ss ■ StkNull THEN BEGIN stkerror[3; RETURN END; 
WITH ss SELECT FROM 
MARK "> 

BEGIN stkerror[]; RETURN; END; 
item ■> 

IF lexeme » topostack THEN tempsneeded ♦- tempsneeded+1; 
ENDCASE; 
nn ^ nn-1; 
ss ♦- ss. downlink; 
ENDLOOP; 
ts ♦- CPtr . tempstart; 
bump temps [temps needed]; 
DO 

IF n " THEN RETURN; 
WITH s SELECT FROM 
item ■> 

IF lexeme ■ topostack THEN 
BEGIN 

tempsneeded *- tempsneeded-1; 
tlex <- createtemplex[ts+tempsneeded, 1]; 
re 1 ease temp lex[ tlex]; 
sCa$sign[tlex.lexsei]; 
lexeme ♦- tlex; 
END; 
ENDCASE; 
n ♦- n-1; 
s ^ s. downlink; 
ENDLOOP; 
END; 



unloadstackcontiguous: PROCEDURE [ss: Stklndex. n: CARDINAL] ■ 
BEGIN -- main subr for bl tnwordsf romstack 
tlex, 1 : se Lexeme; 
s: Stklndex ♦- ss; 
i: CARDINAL ^ 0; 
k, w. ts: CARDINAL; 
a: BitAddress; 

IF n » THEN RETURN; 
DO 

IF s = StkNull THEN BEGIN stkerror[]; RETURN END; 
WITH s SELECT FROM 
MARK «> 

BEGIN stkerror[]; RETURN; END; 
item => 

IF lexeme ff topostack THEN EXIT; 
ENDCASE; 
IF (i ir i + i) « n THEN EXIT; 
s ♦- s. downlink; 
ENDLOOP; 
k <- i ; — k « /^ actually on stack; 
IF i # n THEN 

WITH s SELECT FROM 
item «> 
BEGIN 

a ^ (seb+lexeme. lexsei) . idvalue; 
IF (w ^ a.wd) " (CPtr.tempstart-1) THEN 
UNTIL (i ♦- i + 1) « n DO 
s <- downl ink; 

IF s » StkNull THEN BEGIN stkerror[]; RETURN END; 
WITH s SELECT FROM 
MARK -> 

BEGIN stkerror[]; RETURN END; 
item ■> 
BEGIN 

a <- (seb+lexeme. lexsei) . idvalue; 
IF w+1 ^ a.wd THEN EXIT; 



stack. mesa 2-Sep-78 12:59:69 Page 



END; 
ENDCASE; 
w ^ w-1; 
ENDLOOP; 
END; -- i ■ # already properly contiguous with free temps 
ENDCASE; 
IF i " n AND k ■ THEN RETURN; -- already in contiguous locations 
s ^ ss; 

ts ^ CPtr.tempstart; 
IF i - n THEN 

BEGIN -- ones not on the stack are in the right place. Store others. 

bumptemps[k]; 

FOR i DECREASING IN [0..k) DO 

tlex ^ createtemp1ex[ts+i ,1]; -- peephole will take care of SLD's 

releasetemp1ex[t1ex]; 

sCassign[tlex.1exsei]; 

WITH s SELECT FROM 

item ■> lexeme ♦-tlex; 
ENDCASE; 
s ♦- s. downlink; 
ENDLOOP; 
RETURN; 
END; 
bumptemps[n]; -- they're not contiguous, must copy to a new big temp 
IF (n MOD 2) # THEN 
BEGIN 

tlex ♦- createtemplex[ts+n-l,l]; 
releasetemplex[tlex]; 
WITH s SELECT FROM 
item => 
BEGIN 

IF lexeme ■ topostack THEN sCassign[tlex. lexsei] 
ELSE slCassign[tlex. lexsei , lexeme, FALSE, 1]; 
lexeme ^ tlex; 
END; 
ENDCASE; 
s ^ s. downlink; 
END; 
FOR i DECREASING IN [0..n/2) 
DO 

IF s = StkNull THEN BEGIN stkerror[]; RETURN; END; 
WITH s SELECT FROM 
MARK "> 

BEGIN stkerror[]; RETURN; END; 
item »> 
BEGIN 

tlex ♦- createtemplex[ts+2*i .2]; 
re 1 eas e temp lex[ tlex]; 
ss ♦- downlink; 1 ♦- lexeme; 
IF 1 ff topostack THEN 
WITH ss SELECT FROM 
item »> 

IF lexeme topostack THEN 
BEGIN 

IF trydoubleload[lexeme, 1] - 1 THEN pushlex[l]; 
END; 
ENDCASE 
ELSE 

WITH ss SELECT FROM 
item "> 

IF lexeme ff topostack THEN 
BEGIN 

pushlex[lexeme]; 
CioutO[FOpCodes.qEXCH]; 
END; 
ENDCASE; 
END; 
ENDCASE; 
sCassign[tlex. lexsei]; ^ 

s <- setstklex2[ts+2*i, s]; 
ENDLOOP; 
RETURN 
END; 



setstklex2: PROCEDURE [i: Address, s: Stklndex] RETURNS [Stklndex] 
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BEGIN 
i 4- i+1; 

THROUGH [0..1] DO 
WITH s SELECT FROM 
item ■> 
BEGIN 

lexeme *- createtemp1ex[i , 1]; 
release temp lex[ lexeme]; 
END; 
ENDCASE; 
i i- i-1; 
s <- s. downlink; 
ENDLOOP; 
RETURN[s] 
END; 



trydoubleload: PROCEDURE [11. 12: se Lexeme] RETURNS [CARDINAL] 
BEGIN 

al, a2: BitAddress; 
1 : bdo Lexeme; 

al <- (seb+ll.lexsei) . idvalue; a2 ♦- (seb+l2.1exsei) . idvalue; 
IF a2.wd - (al.wd + 1) THEN 

BEGIN 

1 <- makeBDOItem[ll]; 

cb[l .lexbdoi]. offset. size ^ 2*wordlength; 

pushlex[l]; 

RETURN[2] 

END; 
pushlex[ll]; 
RETURN[1] 
END; 



putrandsonstack: PUBLIC PROCEDURE [n: CARDINAL] « 

BEGIN -- ensures that the n items on stack are in acstack 

stkary: ARRAY [0. .EvalStackSize) OF se Lexeme; 

i, k: CARDINAL; 

s: Stklndex <- stkptr; 

ais: BOOLEAN ♦- TRUE; 

k ^ 0; 

FOR i IN [0..n) DO 

IF s = StkNull THEN BEGIN stkerror[]: RETURN END; 
WITH s SELECT FROM 
MARK -> stkerror[]; 
item ■> 
BEGIN 

stkary[i] ♦- lexeme; 
IF stkary[i] « topostack THEN 
BEGIN 

IF ~ais THEN stkerror[]; 
k 4- k + 1; 
END 
ELSE ais <- FALSE; 
END; 
ENDCASE; 
s ^ s. downlink; 
ENDLOOP: 
IF ais THEN RETURN; 
stackoff []; 

IF n - 2 AND (stkary[0] - topostack) THEN 
BEGIN 

pushlex[stkary[l]] ; 
WITH stkptr. downlink SELECT FROM 
item ■> lexeme <- topostack; 
ENDCASE; 
CioutO[FOpCodes.qEXCH]; 
stackon[]; 
RETURN 
END; 
unloadstack[stkptr, k]; 
s ^ stkptr; 
FOR i IN [0..n) DO 
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WITH s SELECT FROM 
MARK -> stkerror[]; 
item ■> 
BEGIN 

stkary[i] <- lexeme; 
lexeme ^ topostack; 
END; 
ENDCASE; 
s ^ s.downl ink; 
ENDLOOP; 
UNTIL n < 2 DO 

n <- n - trydoubleload[stkary[n-l], stkary[n-2]] ENDLOOP; 
IF n ■ 1 THEN pushlex[stkary[0]] ; 
stackon[]; 
RETURN 
END; 

chkrandsonstack: PUBLIC PROCEDURE [n: CARDINAL] ■ 
BEGIN -- ensures n items on stack and deletes them 
s: Stklndex ^ stkptr; 

IF n ■ THEN RETURN; 

putrandsonstack[n]; 

THROUGH [l..n) DO s *- s. downlink ENDLOOP; 

stkptr ♦- s.downl ink; 

delstkitems[s,n]; 

RETURN 

END; 

gentemplex: PUBLIC PROCEDURE [nwords: CARDINAL] RETURNS [1: se Lexeme] - 
BEGIN 

1 <- createtemplex[CPtr . tempstart , nwords]; 
releasetemplex[l]; 
bump temps [nwords]; 
RETURN 
END; 

genanonlex: PUBLIC PROCEDURE [nwords: CARDINAL] RETURNS [1: se Lexeme] «- 
BEGIN 

1 ♦- createtemplex[CPtr. tempstart, nwords]; 
bump temps [nwords]; 
RETURN 
END; 

genstringbodylex: PUBLIC PROCEDURE [nchars: CARDINAL] RETURNS [1: se Lexeme] 
BEGIN 

nwords: CARDINAL ^ StringDef s.WordsForString[nchars] ; 
IF -CPtr.mainBody THEN RETURN [genanonlex[nwords]] ; 
1 *" createtemplex[MPtr .objectFrameSize, nwords]; 
(seb+1 . lexsei ) .ctxnum <- MPtr .mainCtx; 
MPtr .ObjectFrameSize <- MPtr .objectFrameSize + nwords; 
RETURN 
END; 

bumptemps: PROCEDURE [n: CARDINAL] ■ 

BEGIN -- updates CPtr .tempstart (and CPtr.f ramesz, if necessary) 
CPtr.framesz <- MAX[CPtr. tempstart ♦■ CPtr , tempstart+n, CPtr .framesz]; 
IF CPtr.framesz > VMLimit/wordlength THEN 

ErrorDef s .errorsei[addressOverf low, (bb+MPtr. body Index) .id]; 
RETURN 
END; 

purgependtemplist: PUBLIC PROCEDURE - 

BEGIN -- after each statment the temp sei's are released 
sei: ISEIndex *- pendtempl ist; 
nsei: ISEIndex; 

WHILE sei ^ ISENull DO 

nsei <- SymTabD0fs.NextSe[sei]; 
rel ease tempsoi[ sei]; 
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sei ♦- nsei; 

ENDLOOP; 
pendtempi ist ^ ISENull ; 
RETURN 
END; 

purgeheaplist: PUBLIC PR0CEDURE[o1dheap1 ist: ISEIndex] ■ 
BEGIN -- after each statment the heap chunks are freed 
sei: ISEIndex ^ heaplist; 
nsei: ISEIndex; 
1: se Lexeme *■ Lexeme[se[]] ; 

WHILE sei # ISENull DO 

nsei <- SymTabDefs.NextSe[sei]; 

1 . lexsei <- sei ; 

f reeheap1ex[l3; 

sei <- nsei; 

ENDLOOP; 
heaplist ♦■ oldheaplist; 
RETURN 
END; 

freeheaplex: PUBLIC PROCEDURE [1: se Lexeme] ■ 
BEGIN 

push1ex[l ]; 

CioutO[FOpCodes.qFREE]; 
releasetempsei[1 .lexsei]; 
RETURN 
END; 

pushheaplist: PUBLIC PROCEDURE RETURNS[oldheapl ist: ISEIndex] - 
BEGIN 

oldheaplist <- heaplist; 
heaplist *- ISENull; 
RETURN 
END; 

genheaplex: PUBLIC PROCEDURE RETURNS[1: se Lexeme] - 
BEGIN 

1 <r genanonlex[l]; 

SymTabDef s.setselink[l .lexsei , heapl ist]; 
heapl ist <- 1 .lexsei ; 
RETURN 
END; 

freetempsei: PUBLIC PROCEDURE [sei: ISEIndex] - 
BEGIN -- de-links a temp sei from its chain 
SymTabDef s. setselink[sei, tempi istpool ]; 
tempi istpool <- sei ; 
RETURN 
END; 

releasetempsei: PROCEDURE [sei: ISEIndex] ■ 
BEGIN -- puts a temp sei on the tempi ist 
a: BitAddress *- (seb+sei) . idvalue; 

CPtr.tempstart <- MIN[CPtr. tempstart, a.wd]; 

f reetempsei[sei]; 

RETURN 

END; 

createtemplex: PROCEDURE [wdoffset, nwords: INTEGER] RETURNS [1: se Lexeme] 
BEGIN -- inits (if nee) a new temp sei cell 
sei: ISEIndex; 
a: BitAddress; 

IF tempi istpool # SENull THEN 
BEGIN 

sei ^ tempi istpool ; 
templistpool <- SymTabDef s .NextSe[se i]; 
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(seb+sei) .ctxnuin <■ CPtr.tempcontext; 

END 
ELSE 

BEGIN 

sei ^ Tab1eDefs.Anocate[SyniD8fs.setype, SIZE[linked id SERecord]]; 

(seb+S8i)t ♦- SERecord[mark3: , mark4; , 

sebody: id[extend8d: FALSE, public: , writeonce: , linkSpace: FALSE, 

constant: FALSE, ctxnum: CPtr.tempcontext, htptr:HTNun , 

idtype: typeANY. idinfo: , idvalue: . ctxlink: 1 inked[LOOPHOLE[0]]]]; 

END; 
SymTabDefs.setse1ink[sei, LOOPHOLE[0]]; 
a ^ BitAddress[wd: wdoffset, bd: 0]; 
(seb+sei) .idvalue ♦- a; 
(seb+sei) . idinfo *- nwords*word1ength; 
1 ♦- Lexeine[se[lexs8i : sei]]; 
RETURN 
END; 

releasetemplex: PUBLIC PROCEDURE [1: se Lexeme] ■ 
BEGIN -- releases a cell of temporary storage 

IF SymTabDefs.NextSe[1.1exsei] # LOOPHOLE[0, ISEIndex] THEN RETURN; 
SymTabDef s.setsel ink[1 .lexsei , pendtemplist]; 
pendtemplist *■ 1. lexsei; 
RETURN 
END; 

freetemplist: PUBLIC PROCEDURE ■ 

BEGIN -- at end of body puts se-entries of temp cells on list from tempi istpool 
sei: ISEIndex <- templist; 
nsei ; ISEIndex; 

UNTIL sei - ISENull DO 

nsei ^ SymTabDefs.NextSe[sei]; 

f reetempsei[sei]; 

sei ♦- nsei; 

ENDLOOP; 
templist ♦- ISENull ; 
RETURN 
END; 

chkacstack: PUBLIC PROCEDURE [b: BYTE] - 
BEGIN -- checks AC stack for over/underflow 
pusheffect: INTEGER - PushEf fect[b]; 
popeffect: INTEGER - PopEf f ectCb]; 
neteffect: INTEGER - pusheffect - popeffect; 

IF (CPtr.acstack + neteffect) > stkUB THEN 

BEGIN 

IF (stkUB i- stkUB+1) > EvalStackSize THEN 

BEGIN SIGNAL CPtr . ACStackOverf low; RETURN; END; 

dumpstack[]; 

CPtr.acstack ♦- 0; 

StkUB ^ EvalStackSize - 2; 

END; 
IF CPtr.stking THEN 

BEGIN chkrandsonstack[popef feet] ; incrstack[pusheffect]; END; 
IF CPtr.acstack ff popeffect AND MinimalStack[b] THEN 

SIGNAL StackModelingError; 
IF (CPtr.acstack *- CPtr.acstack + neteffect) < THEN 

SIGNAL CPtr.ACStackUnderflow; 
RETURN 
END; 

adjustacstack: PUBLIC PROCEDURE [x: INTEGER] - 

BEGIN -- used to adjust acstack at fork join points 
CPtr.acstack *- CPtr.acstack+x; 
SELECT CPtr.acstack FROM 

>stkUB -> SIGNAL CPtr .ACStackOverf low; 

< -> SIGNAL CPtr.ACStackUnderflow; 

ENDCASE; 
RETURN 
END; 
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END. 



